home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / UNITS / PBDDL.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  5KB  |  189 lines
  1.  
  2. Unit PbDDL;
  3.  
  4. INTERFACE
  5.  
  6. uses PbMISC;
  7.  
  8. {
  9. Description:  Sort of a mini-Data Dictionary - for SCRNGEN
  10.  
  11. Author      : Howard Richoux
  12. Date        : 2/1/94  still fluid
  13. Last revised: 2/18/94 NEW LIBRARIES
  14. Application : IBM PC and compatibles, done in Turbo Pascal 7.0
  15. Status      : Placed in the Public Domain by HNR Software 1/29/1994
  16. Published in: none
  17. }
  18.  
  19.  
  20.  
  21. type DDLRec = record
  22.      nam    : string[24];     { field name }
  23.      typ    : char;           { field type }
  24.      len    : byte;           { data length }
  25.      decp   : byte;           { decimals }
  26.      r,c,l  : byte;           { row, col, display len }
  27.      prompt : string[20];     { display prompt }
  28.      options: string[40];     { picture/readonly/... }
  29.      end;
  30.  
  31.  
  32. {SECTION .DDL_object }
  33.  
  34. const fldsmax = 100;
  35.  
  36. type DDL_object = object
  37.         ddl   : array[1..fldsmax] of DDLRec;
  38.         count : integer;
  39.  
  40.         Procedure init;
  41.         Procedure append(nam : string; typ : char; len,decp : integer);
  42.         Function  find  (nam : string) : integer;
  43.         Procedure dump;
  44.         Procedure done;
  45.         end;
  46.  
  47. {SECTION .Procs }
  48.  
  49. Function  DDLRecSize(var flds : DDL_object) : integer;
  50.  
  51. Procedure FieldSpecToPbDDL(FieldSpec : string; var flds : DDL_object);
  52.  
  53.  
  54. {SECTION  .zImplementation }
  55. IMPLEMENTATION
  56.  
  57.  
  58. Function  DDLRecSize(var flds : DDL_object) : integer;
  59. var i,j : integer;
  60.      begin
  61.      j := 0;
  62.      if flds.count > 0 then
  63.           begin
  64.           for i := 1 to flds.count do j := j + flds.ddl[i].len;
  65.           end;
  66.      DDLRecSize := j;
  67.      end;
  68.  
  69.  
  70.  
  71. {SECTION  FieldSpecToPbDDL }
  72. Procedure FieldSpecToPbDDL(FieldSpec : string; var flds : DDL_object);
  73. var i        : integer;
  74.     s, s1,s2,s3 : string;
  75. var x        : DDLRec;
  76.      begin
  77.      writeln('-------');
  78.      s := RemoveBrackets(FieldSpec);
  79.      writeln('{FIELDS='+s+'}');
  80.      while length(s) > 0 do
  81.           begin
  82.           fillchar(x,sizeof(x),0);
  83.           s1 := GetLeftStr(s,',');
  84.          { writeln('[',s1,']'); pause; }
  85.           s2 := UpCaseStr(GetDelimitedStr(s1,'(',')'));
  86.           x.nam := s1;
  87.           x.typ := s2[1];
  88.           case s2[1] of
  89.              'C' : begin    {char array}
  90.                    i  := GetInteger(s2);
  91.                    if i = 0 then i := 1;
  92.                    end;
  93.              'D' : i := 8;  {DBase Date field}
  94.              'I' : i := 2;  {integer}
  95.              'L' : i := 4;  {longint}
  96.              'N' : begin    {DBase Number field}
  97.                    delete(s2,1,1);  {N}
  98.                    s1 := GetLeftStr(s2,'.');
  99.                    i := Strint(s1);
  100.                    x.decp := strint(s2);
  101.                    end;
  102.              'R' : i := 4;  {real}
  103.              'S' : begin    {string}
  104.                    i  := GetInteger(s2);
  105.                    if i = 0 then i := 1;
  106.                    end;
  107.               else begin
  108.                    writeln('Unknown field type [',s2[1],']');
  109.                    i := 0;
  110.                    end;
  111.               end;
  112.           x.len := i;
  113.           flds.append(x.nam,x.typ,x.len,x.decp);
  114.           end;
  115.      writeln('-------');
  116.      writeln('  Total length ',DDLRecSize(flds));
  117.      writeln('-------');
  118.      end;
  119.  
  120.  
  121. {SECTION  DDL_object }
  122. Procedure DDL_object.init;
  123.      begin
  124.      fillchar(ddl,sizeof(ddl),0);
  125.      count := 0;
  126.      end;
  127.  
  128.  
  129. Procedure DDL_object.append(nam : string; typ : char; len,decp : integer);
  130. var s : string;
  131.      begin
  132.      if count < fldsmax then
  133.           begin
  134.           inc(count);
  135.           s := nam;
  136.           trim(s);
  137.           s := UpCaseStr(s);
  138.           ddl[count].nam  := s;
  139.           ddl[count].typ  := UpCase(typ);
  140.           ddl[count].len  := len;
  141.           ddl[count].decp := decp;
  142.           end;
  143.      end;
  144.  
  145.  
  146. Function  DDL_object.find  (nam : string) : integer;
  147. var i,j : integer;
  148.      begin
  149.      j := 0;
  150.      if count > 0 then
  151.           begin
  152.           for i := 1 to count do
  153.                begin
  154.                if nam = ddl[i].nam then j := i;
  155.                end;
  156.           end;
  157.      find := j;
  158.      end;
  159.  
  160.  
  161. Procedure DDL_object.dump;
  162. var i : integer;
  163.      begin
  164.      writeln('dumping DDL   fields = ',count);
  165.      if count > 0 then
  166.           begin
  167.           for i := 1 to count do
  168.                begin
  169.                writeln('[',ddl[i].nam,']  ',ddl[i].typ,'  ',
  170.                            ddl[i].len, '  ',ddl[i].decp,'  (',
  171.                            ddl[i].r,',',ddl[i].c,')  ',ddl[i].l);
  172.                end;
  173.           end;
  174.      end;
  175.  
  176.  
  177. Procedure DDL_object.done;
  178.      begin
  179.      count := 0;
  180.      end;
  181.  
  182.  
  183.  
  184.  
  185.      begin {initialization}
  186.      end.
  187.  
  188.  
  189.